Podsumowanie

Celem niniejszej analizy było zbadanie danych dotyczących baterii oraz stworzenie modelu predykcyjnego dla średniego napięcia na podstawie pozostałych atrybutów baterii. Analiza została przeprowadzona na podstawie zbioru danych udostępnionego przez Materials Project, inicjatywę naukową Departamentu Energii USA. Po przeprowadzeniu analizy stwierdzono, że największy wpływ na średnią wartość napięcia baterii miała energia wolumetryczna.

Wykorzystane biblioteki

W raporcie wykorzystano następujące biblioteki:

library(knitr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(plotly)
library(ggcorrplot)
library(caret)
library(tibble)
library(kableExtra)

Wczytanie danych

Materials Project to inicjatywa naukowa Departamentu Energii USA, której celem jest dostarczanie otwartych danych i narzędzi do analizy materiałów. Jednym z kluczowych zbiorów danych dostępnych w ramach Materials Project jest baza danych dotycząca materiałów używanych w bateriach, która zawiera informacje o ich składzie chemicznym i parametrach wydajnościowych.

df <- read.csv("./data/mp_batteries.csv", na.strings="?")
df <- tbl_df(df)

Opis atrybutów

Nazwa atrybutu Opis
Battery ID Identyfikator baterii.
Battery Formula Wzór chemiczny materiału baterii.
Working Ion Główny jon, który odpowiada za transport ładunku w baterii.
Formula Charge Wzór chemiczny materiału baterii w stanie naładowanym.
Formula Discharge Wzór chemiczny materiału baterii w stanie rozładowanym.
Max Delta Volume Zmiana objętości w % dla danego kroku napięcia za pomocą wzoru : max(charge, discharge)/min(charge, discharge) -1.
Average Voltage Średnie napięcie dla poszczególnego kroku napięcia.
Gravimetric Capacity Pojemność grawimetryczna, czyli ilość energii na jednostkę masy (mAh/g).
Volumetric Capacity Pojemność wolumetryczna, czyli ilość energii na jednostkę objętości (mAh/cm³).
Gravimetric Energy Gęstość energii w odniesieniu do masy baterii (Wh/kg).
Volumetric Energy Gęstość energii w odniesieniu do objętości baterii (Wh/L).
Atomic Fraction Charge Udział atomowy składników w stanie naładowanym.
Atomic Fraction Discharge Udział atomowy składników w stanie rozładowanym.
Stability Charge Wskaźnik stabilności materiału w stanie naładowanym.
Stability Discharge Wskaźnik stabilności materiału w stanie rozładowanym.
Steps Liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana, oparta na stabilnych stanach pośrednich.
Max Voltage Step Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia.

Czyszczenie zbioru danych

Poniżej znajduje się lista kroków wykonanych na zbiorze danych w celu przygotowania go do anaizy.

Struktura danych

Struktura ramki danych
tibble [4,351 × 17] (S3: tbl_df/tbl/data.frame)
$ Battery.ID : chr [1:4351] “mp-30_Al” “mp-1022721_Al” “mp-8637_Al” “mp-129_Al” …
$ Battery.Formula : chr [1:4351] “Al0-2Cu” “Al1-3Cu” “Al0-5Mo” “Al0-12Mo” …
$ Working.Ion : chr [1:4351] “Al” “Al” “Al” “Al” …
$ Formula.Charge : chr [1:4351] “Cu” “AlCu” “Mo” “Mo” …
$ Formula.Discharge : chr [1:4351] “Al2Cu” “Al3Cu” “Al5Mo” “Al12Mo” …
$ Max.Delta.Volume : num [1:4351] 3.04 1.24 4.76 12.72 12.49 …
$ Average.Voltage : num [1:4351] 0.089 -0.0216 0.1228 0.0431 0.0292 …
$ Gravimetric.Capacity : num [1:4351] 1368 1113 1742 2299 1901 …
$ Volumetric.Capacity : num [1:4351] 5563 4419 7176 7346 7333 …
$ Gravimetric.Energy : num [1:4351] 121.8 -24 213.8 99.1 55.6 …
$ Volumetric.Energy : num [1:4351] 495.3 -95.4 880.9 316.8 214.4 …
$ Atomic.Fraction.Charge : num [1:4351] 0 0.5 0 0 0 …
$ Atomic.Fraction.Discharge: num [1:4351] 0.667 0.75 0.833 0.923 0.923 …
$ Stability.Charge : num [1:4351] 0 0.0741 0.4115 0 0 …
$ Stability.Discharge : num [1:4351] 0 0.0962 0.0452 0.0114 0 …
$ Steps : int [1:4351] 1 1 1 1 1 1 1 1 1 1 …
$ Max.Voltage.Step : num [1:4351] 0 0 0 0 0 0 0 0 0 0 …

Kilka pierwszych wierszy ze zbioru danych

Battery.ID Battery.Formula Working.Ion Formula.Charge Formula.Discharge Max.Delta.Volume Average.Voltage Gravimetric.Capacity Volumetric.Capacity Gravimetric.Energy Volumetric.Energy Atomic.Fraction.Charge Atomic.Fraction.Discharge Stability.Charge Stability.Discharge Steps Max.Voltage.Step
mp-30_Al Al0-2Cu Al Cu Al2Cu 3.0433992 0.0890331 1368.48055 5562.7901 121.840086 495.272533 0.0000000 0.6666667 0.0000000 0.0000000 1 0
mp-1022721_Al Al1-3Cu Al AlCu Al3Cu 1.2436528 -0.0215863 1112.93655 4418.9798 -24.024232 -95.389622 0.5000000 0.7500000 0.0740612 0.0962458 1 0
mp-8637_Al Al0-5Mo Al Mo Al5Mo 4.7625743 0.1227568 1741.50416 7175.7017 213.781556 880.866507 0.0000000 0.8333333 0.4114601 0.0452120 1 0
mp-129_Al Al0-12Mo Al Mo Al12Mo 12.7238931 0.0431214 2298.81076 7346.2323 99.128013 316.780060 0.0000000 0.9230769 0.0000000 0.0114456 1 0
mp-91_Al Al0-12W Al W Al12W 12.4945977 0.0292342 1900.74513 7332.7186 55.566774 214.366205 0.0000000 0.9230769 0.0000000 0.0000000 1 0
mp-1055908_Al Al0-12Mn Al Mn MnAl12 18.2361563 0.0397314 2547.69280 7592.9161 101.223298 301.676876 0.0000000 0.9230769 0.1454643 0.0000000 1 0
mp-2658_Al Al0-1Fe Al Fe AlFe 0.7711539 0.4717287 970.75702 5622.3562 457.933974 2652.226958 0.0000000 0.5000000 0.7613994 0.0000000 1 0
mp-16722_Al Al1-10.25V Al Al10V Al41V4 0.0027108 -0.0155827 61.37701 176.4151 -0.956421 -2.749028 0.9090909 0.9111111 0.0118097 0.0125861 1 0
mp-998981_Al Al1-3Ti Al TiAl TiAl3 0.9562924 0.1602450 1248.40362 4248.4211 200.050419 680.788169 0.5000000 0.7500000 0.1415912 0.0244962 1 0
mp-8633_K K0-3Cr K Cr K3Cr 15.8029363 -0.7487069 474.94813 667.5593 -355.596958 -499.806269 0.0000000 0.7500000 0.4025263 0.6621618 1 0
mp-8640_K K0-3Hf K Hf K3Hf 7.6097655 -1.4790313 271.83417 689.1858 -402.051260 -1019.327437 0.0000000 0.7500000 0.0724082 1.1273756 1 0
mp-8634_K K0-3Mn K Mn K3Mn 16.9232363 -0.8393424 466.83544 689.3385 -391.834783 -578.591003 0.0000000 0.7500000 0.0830981 0.6502813 1 0
mp-8637_K K0-3Mo K Mo K3Mo 11.2468574 -1.4178585 377.06981 675.2837 -534.631623 -957.456674 0.0000000 0.7500000 0.4114601 1.1662589 1 0
mp-8642_K K0-3Re K Re K3Re 10.3987219 -1.9828195 264.92237 774.8719 -525.293242 -1536.431174 0.0000000 0.7500000 0.0627568 1.5028038 1 0
mp-8632_K K0-3V K V K3V 13.0605399 -1.0947808 477.92537 681.8803 -523.223504 -746.509444 0.0000000 0.7500000 0.2471404 0.8828707 1 0
mp-8641_K K0-3W K W K3W 10.1121849 -1.8449306 267.00473 727.0998 -492.605208 -1341.448692 0.0000000 0.7500000 0.4714241 1.5015540 1 0
mp-8634_Ca Ca0-3Mn Ca Mn Ca3Mn 10.8286680 -0.2316551 918.00542 2089.0224 -212.660602 -483.932614 0.0000000 0.7500000 0.0830981 0.3682571 1 0
mp-8633_Li Li0-3Cr Li Cr Li3Cr 5.1580521 -0.4076942 1104.16695 1821.5104 -450.162431 -742.619186 0.0000000 0.7500000 0.4025263 0.4064022 1 0
mp-8636_Li Li0-3Nb Li Nb Li3Nb 2.3814957 -0.8254060 706.98041 2085.1784 -583.545844 -1721.118698 0.0000000 0.7500000 0.3201642 0.6990955 1 0
mp-102_Rb Rb0-3Co Rb Co Rb3Co 17.4204448 -1.1292823 254.97974 664.1585 -287.944098 -750.022366 0.0000000 0.7500000 0.0161140 0.8509902 1 0
mp-8634_Rb Rb0-3Mn Rb Mn Rb3Mn 20.6965362 -0.8831153 258.25166 569.4539 -228.065988 -502.893416 0.0000000 0.7500000 0.0830981 0.6831110 1 0
mp-8637_Rb Rb0-3Mo Rb Mo Rb3Mo 13.4775228 -1.4691341 228.19909 571.2374 -335.255062 -839.224376 0.0000000 0.7500000 0.4114601 1.2047156 1 0
mp-8642_Rb Rb0-3Re Rb Re Rb3Re 12.2810875 -2.0555178 181.65963 665.0472 -373.404617 -1367.016318 0.0000000 0.7500000 0.0627568 1.5573276 1 0
mp-8632_Rb Rb0-3V Rb V Rb3V 15.5109635 -1.1510190 261.60982 580.6811 -301.117862 -668.375011 0.0000000 0.7500000 0.2471404 0.9250493 1 0
mp-8641_Rb Rb0-3W Rb W Rb3W 12.3636271 -1.9016930 182.63634 604.6014 -347.318243 -1149.766201 0.0000000 0.7500000 0.4714241 1.5441257 1 0
mp-102_Na Na0-3Co Na Co Na3Co 8.0250126 -0.8766266 628.63855 1355.5764 -551.081257 -1188.334319 0.0000000 0.7500000 0.0161140 0.6614984 1 0
mp-23_Na Na0-3Ni Na Ni Na3Ni 7.9735171 -0.5556719 629.81935 1381.2293 -349.972899 -767.510265 0.0000000 0.7500000 0.0000000 0.4167539 1 0
mp-568345_Na Na0-3Fe Na Fe Na3Fe 7.1963242 -0.6615578 644.19252 1214.9419 -426.170582 -803.754301 0.0000000 0.7500000 0.7613994 0.6865182 1 0
mp-8642_Na Na0-3Re Na Re Na3Re 5.8592848 -1.7147724 315.09369 1287.6779 -540.313949 -2208.074566 0.0000000 0.7500000 0.0627568 1.3017685 1 0
mp-567597_Y Y0-3Bi Y Bi Y3Bi 2.3251246 0.1547191 507.07246 3420.2399 78.453815 529.176575 0.0000000 0.7500000 0.0495452 0.1487189 1 0

Analiza jakości danych

Sprawdzenie ile jest pustych wartościami w poszczególnych kolumnach oraz ile w zbiorze jest zduplikowanych wierszy.

na_counts <- colSums(is.na(df))
kable(na_counts, col.names = c("Brakujące wartości"), caption = "Liczba brakujących wartości w kolumnach")
Liczba brakujących wartości w kolumnach
Brakujące wartości
Battery.ID 0
Battery.Formula 0
Working.Ion 0
Formula.Charge 0
Formula.Discharge 0
Max.Delta.Volume 0
Average.Voltage 0
Gravimetric.Capacity 0
Volumetric.Capacity 0
Gravimetric.Energy 0
Volumetric.Energy 0
Atomic.Fraction.Charge 0
Atomic.Fraction.Discharge 0
Stability.Charge 0
Stability.Discharge 0
Steps 0
Max.Voltage.Step 0
duplicates_count <- sum(duplicated(df))

Liczba zduplikowanych wierszy: 0.

Z powodu braku zduplikowanych danych oraz braku wartości pustych w zbiorze - dane nie wymagają czyszczenia.

Podstawowe statystyki

Zbiór danych składa się z 4351 wierszy (obserwacji) i 17 kolumn (atrybutów).

kable(summary(df %>% select(Max.Delta.Volume:Volumetric.Energy)))
Max.Delta.Volume Average.Voltage Gravimetric.Capacity Volumetric.Capacity Gravimetric.Energy Volumetric.Energy
Min. : 0.00002 Min. :-7.755 Min. : 5.176 Min. : 24.08 Min. :-583.5 Min. :-2208.1
1st Qu.: 0.01747 1st Qu.: 2.226 1st Qu.: 88.108 1st Qu.: 311.62 1st Qu.: 211.7 1st Qu.: 821.6
Median : 0.04203 Median : 3.301 Median : 130.691 Median : 507.03 Median : 401.8 Median : 1463.8
Mean : 0.37531 Mean : 3.083 Mean : 158.291 Mean : 610.62 Mean : 444.1 Mean : 1664.0
3rd Qu.: 0.08595 3rd Qu.: 4.019 3rd Qu.: 187.600 3rd Qu.: 722.75 3rd Qu.: 614.4 3rd Qu.: 2252.3
Max. :293.19322 Max. :54.569 Max. :2557.627 Max. :7619.19 Max. :5926.9 Max. :18305.9
kable(summary(df %>% select(Atomic.Fraction.Charge:Max.Voltage.Step)))
Atomic.Fraction.Charge Atomic.Fraction.Discharge Stability.Charge Stability.Discharge Steps Max.Voltage.Step
Min. :0.00000 Min. :0.007407 Min. :0.00000 Min. :0.00000 Min. :1.000 Min. : 0.0000
1st Qu.:0.00000 1st Qu.:0.086957 1st Qu.:0.03301 1st Qu.:0.01952 1st Qu.:1.000 1st Qu.: 0.0000
Median :0.00000 Median :0.142857 Median :0.07319 Median :0.04878 Median :1.000 Median : 0.0000
Mean :0.03986 Mean :0.159077 Mean :0.14257 Mean :0.12207 Mean :1.167 Mean : 0.1503
3rd Qu.:0.04762 3rd Qu.:0.200000 3rd Qu.:0.13160 3rd Qu.:0.09299 3rd Qu.:1.000 3rd Qu.: 0.0000
Max. :0.90909 Max. :0.993333 Max. :6.48710 Max. :6.27781 Max. :6.000 Max. :26.9607

Cechy statystyczne zbioru danych

W tym zbiorze można odczytać następujące cechy statystyczne:

  • Wartości skrajne: Zauważalna jest duża zmienność i obecność skrajnych wartości (np. Max.Delta.Volume, Volumetric.Capacity, Gravimetric.Energy), które mogą wymagać dalszej analizy pod kątem anomalii.
  • Wartości ujemne: Atrybuty takie jak Average.Voltage, Gravimetric.Energy, Volumetric.Energy zawierają ujemne wartości, co sugeruje możliwość błędów w danych lub specyficzną charakterystykę badanych baterii.
  • Skumulowane dane: Większość danych ma bardzo małą zmienność w niektórych atrybutach (np. Steps, Max.Voltage.Step), co może sugerować, że niektóre zmienne są stałe w większości przypadków.

Analiza danych

Poniżej znajduje się analiza zbioru danych w celu zbadania rozkładów wartości poszczególnych atrybutów oraz sprawdzenia występujących między nimi korelacji.

Rozkład wartości atrybutów

p <- ggplot(df, aes(x = `Working.Ion`)) +
  geom_bar(fill = "blue", color = "black") +
  labs(
    title = "Histogram głównego jonu baterii",
    x = "Główny Jon",
    y = "Liczba"
  ) +
  theme_light()

ggplotly(p)
mean <- mean(df$Max.Delta.Volume, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Max.Delta.Volume`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład maksymalnej zmiany objętości dla danego kroku",
    x = "Maksymalna zmiana objętości",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Average.Voltage, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Average.Voltage`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład średniego napięcia",
    x = "Średnie napięcie",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Gravimetric.Capacity, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Gravimetric.Capacity`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład pojemności grawimetrycznej",
    x = "Pojemność grawimetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Volumetric.Capacity, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Volumetric.Capacity`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład pojemności wolumetrycznej",
    x = "Pojemność wolumetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Gravimetric.Energy, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Gravimetric.Energy`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład energii grawimetrycznej",
    x = "Energia grawimetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Volumetric.Energy, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Volumetric.Energy`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład energii wolumetrycznej",
    x = "Energia wolumetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Atomic.Fraction.Charge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Charge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład udziału atomowego składników w stanie naładowanym",
    x = "Udział atomowy składników",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Atomic.Fraction.Discharge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Discharge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład udziału atomowego składników w stanie rozładowanym",
    x = "Udział atomowy składników",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Stability.Charge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Stability.Charge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład wskaźnika stabilności materiału w stanie naładowanym",
    x = "Wskaźnik stabilności materiału",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Stability.Discharge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Stability.Discharge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład wskaźnika stabilności materiału w stanie rozładowanym",
    x = "Wskaźnik stabilności materiału",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Steps, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Steps`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana",
    x = "Liczba kroków",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)
mean <- mean(df$Max.Voltage.Step, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Max.Voltage.Step`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład maksymalnej bezwzględnej różnica między sąsiednimi krokami napięcia",
    x = "Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

Korelacja pomiędzy atrybutami

Poniżej przedstawiono macierz korelacji między wybranymi atrybutami zestawu danych. Kolory kafelków wskazują wartość współczynnika korelacji Pearsona: niebieski reprezentuje silną ujemną korelację, biały brak korelacji, a czerwony silną dodatnią korelację. Liczby na kafelkach przedstawiają dokładne wartości korelacji, co umożliwia szybką analizę zależności między zmiennymi.

cor_matrix <- df %>%
  select(`Max.Delta.Volume`:last_col()) %>%
  cor(method="pearson")

correlation_long <- cor_matrix %>%
  as.data.frame() %>%
  mutate(variable1 = colnames(cor_matrix)) %>%
  pivot_longer(-variable1,
    names_to = "variable2",
    values_to = "correlation"
  ) %>%
  filter(variable1 > variable2)

correlation_plot <- ggplot(
  correlation_long,
  aes(x = variable1, y = variable2, fill = correlation)
) +
  geom_tile() +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 0, limits = c(-1, 1)
  ) +
  geom_text(aes(label = sprintf("%.2f", correlation)), size = 3) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    axis.title = element_blank()
  ) +
  labs(fill = "Korelacja")

ggplotly(correlation_plot)

Poniżej przedstawiono wykresy ilustrujące zależności między wybranymi parami atrybutów. Każdy wykres pokazuje punktowy rozkład obserwacji oraz linię trendu wyznaczoną za pomocą modelu liniowego.

plot_correlation <- function(df, var1, var2) {
  ggplot(df, aes_string(x = var1, y = var2)) +
    geom_point(alpha = 0.5, color = "blue") +
    geom_smooth(method = "lm", se = TRUE, color = "red", fill = "pink") +
    theme_minimal() +
    labs(
      title = paste("Korelacja między", var1, "a", var2),
      x = var1,
      y = var2
    ) +
    theme(
      plot.title = element_text(hjust = 0.5, size = 14),
      axis.text = element_text(size = 10),
      axis.title = element_text(size = 11)
    )
}

pairs <- list(
  c("Gravimetric.Energy", "Volumetric.Energy"),
  c("Gravimetric.Capacity", "Volumetric.Capacity"),
  c("Stability.Charge", "Stability.Discharge")
)

for (pair in pairs) {
  print(plot_correlation(df, pair[1], pair[2]))
}

Wnioski z analizy

  • Główne jony: Widać wyraźną dominację występowania baterii posiadających Lit (Li) jako główny jon
  • Symetryczność wykresów: Większość wykresów ma charakter prawoskośny, co oznacza, że dane są skupione po lewej stronie z długim ogonem w prawo. Może to wskazywać na obecność outlierów (wartości odstających) w danych, które mają duży wpływ na analizowane zmienne.
  • Skumulowane dane: Wiele atrybutów (np. Steps, Max.Voltage.Step) ma małą zmienność, a dane są skoncentrowane w wąskim zakresie, co może ograniczać ich wartość predykcyjną.
  • Korelacje między atrybutami: Z analizy korelacji wynika, że niektóre atrybuty są ze sobą silnie skorelowane, co sugeruje możliwość ich redukcji lub usunięcia, aby uniknąć problemu multikolinearności w dalszej analizie. Na przykład, atrybuty takie pary jak Gravimetric.Energy i Volumetric.Energy, Gravimetric.Capacity i Volumetric.Capacity, Stability.Charge i Stablility.Discharge wykazują bardzo wysoką dodatnią korelację, co może wpływać na stabilność modeli predykcyjnych.

Regresor

W tej sekcji przedstawiono proces tworzenia modelu regresji, obejmujący redukcję atrybutów o wysokiej korelacji, przygotowanie zbiorów danych oraz trenowanie modelu z wykorzystaniem walidacji krzyżowej. Wyniki modelu zostały ocenione za pomocą metryk jakości oraz wizualnie porównane z danymi testowymi.

Redukcja korelacji

Aby zredukować korelacje między atrybutami, zastosowano funkcję findCorrelation z pakietu caret, ustawiając próg (cutoff) na 0.6. Funkcja ta identyfikuje atrybuty, które są silnie skorelowane i mogą zostać usunięte z analizy.

attributes_to_remove <- cor_matrix %>% findCorrelation(cutoff = 0.6, names = TRUE)

Atrybuty, które zostały wybrane do usunięcia: Gravimetric.Energy, Gravimetric.Capacity, Atomic.Fraction.Discharge, Stability.Charge.

Trenowanie modelu

Do budowy modelu predykcyjnego usunięto atrybuty Gravimetric.Energy, Gravimetric.Capacity, Atomic.Fraction.Discharge, Stability.Charge oraz Battery.ID. Dane zostały podzielone na zbiór uczący (70%) oraz testowy (30%). Dodatkowo, w celu oceny modelu, zastosowano ocenę krzyżową (cross-validation) z 10-krotnym podziałem zbioru danych na podzbiory.

df$Battery.Formula <- as.numeric(factor(df$Battery.Formula))
df$Working.Ion <- as.numeric(factor(df$Working.Ion))
df$Formula.Charge <- as.numeric(factor(df$Formula.Charge))
df$Formula.Discharge <- as.numeric(factor(df$Formula.Discharge))
in_training_data <- createDataPartition(y = df$Average.Voltage, p = 0.70, list = FALSE)

training_data <- df[in_training_data, ] %>% select(-c(Battery.ID, attributes_to_remove))
testing_data <- df[-in_training_data, ]

ctrl <- trainControl(method = "cv", number = 10)

Poniższy wykres przedstawia podobieństwo rozkładów danych treningowych i testowych.

ggplot() +
  geom_density(aes(x = Average.Voltage, fill = "Treningowy"), data = training_data, alpha = 0.6) +
  geom_density(aes(x = Average.Voltage, fill = "Testowy"), data = testing_data, alpha = 0.6) +
  labs(x = "Average Voltage", y = "Gęstość", fill = "Zbiór danych") +
  theme_light()

model_lm <- train(
  Average.Voltage ~ .,
  data = training_data,
  method = "lm",
  trControl = ctrl
)

Podsumowanie modelu

Podsumowanie zawiera szczegółowe informacje o współczynnikach regresji, w tym ich wartości, błędy standardowe, statystyki t oraz p-wartości, co pozwala ocenić znaczenie poszczególnych predyktorów w modelu.

model_summary <- summary(model_lm)

residuals_summary <- data.frame(
  Metric = c("Min", "1Q", "Mediana", "Brak reszty", "3Q", "Max"),
  Value = as.numeric(summary(model_summary$residuals))
)
kable(residuals_summary, caption = "Podsumowanie reszt modelu")
Podsumowanie reszt modelu
Metric Value
Min -6.3627997
1Q -0.6204801
Mediana -0.0532169
Brak reszty 0.0000000
3Q 0.5494741
Max 23.7898552
kable(as.data.frame(model_summary$coefficients),
      caption = "Podsumowanie wyników modelu liniowego",
      col.names = c("Współczynnik", "Wartość", "Standard Error", "t-Statystyka", "p-Wartość"))
Podsumowanie wyników modelu liniowego
Współczynnik Wartość Standard Error t-Statystyka p-Wartość
(Intercept) 3.1371173 0.1156145 27.1342824 0.0000000
Battery.Formula -0.0002763 0.0000541 -5.1046084 0.0000004
Working.Ion -0.0246354 0.0271988 -0.9057548 0.3651375
Formula.Charge -0.0001272 0.0000346 -3.6720831 0.0002447
Formula.Discharge 0.0001570 0.0000430 3.6482901 0.0002684
Max.Delta.Volume 0.2317628 0.0253167 9.1545576 0.0000000
Volumetric.Capacity -0.0013795 0.0000606 -22.7651446 0.0000000
Volumetric.Energy 0.0009911 0.0000209 47.5337868 0.0000000
Atomic.Fraction.Charge 2.5331915 0.4378644 5.7853338 0.0000000
Atomic.Fraction.Discharge -1.2220230 0.4222202 -2.8942791 0.0038274
Stability.Discharge -0.4251615 0.0620153 -6.8557546 0.0000000
Steps -0.2614434 0.0646566 -4.0435684 0.0000540
Max.Voltage.Step 0.1054219 0.0589217 1.7891854 0.0736847
fit_statistics <- data.frame(
  Metric = c("R-squared", "Adjusted R-squared", "Residual Std. Error"),
  Value = c(
    model_summary$r.squared,
    model_summary$adj.r.squared,
    model_summary$sigma
  )
)
kable(fit_statistics, caption = "Statystyki dopasowania modelu")
Statystyki dopasowania modelu
Metric Value
R-squared 0.5248056
Adjusted R-squared 0.5229261
Residual Std. Error 1.1735086
f_stat <- data.frame(
  Metric = "F-statistic",
  Value = model_summary$fstatistic[1],
  DF = paste(model_summary$fstatistic[2:3], collapse = " and "),
  `P-value` = pf(model_summary$fstatistic[1],
                 model_summary$fstatistic[2],
                 model_summary$fstatistic[3],
                 lower.tail = FALSE)
)
kable(f_stat, caption = "Test istotności całego modelu")
Test istotności całego modelu
Metric Value DF P.value
value F-statistic 279.2296 12 and 3034 0

Predykcje na zbiorze testowym

Wyniki predykcji na zbiorze testowym są oceniane za pomocą metryk jakości takich jak RMSE (Root Mean Square Error), R² (współczynnik determinacji) oraz MAE (Mean Absolute Error). Metryki te pozwalają ocenić dokładność i dopasowanie modelu do danych.

predictions <- predict(model_lm, newdata = testing_data)
post_resample <- postResample(pred = predictions,
                              obs = testing_data$Average.Voltage)
kable(post_resample, col.names = c("Metryka", "Wartość"), caption = "Ocena modelu - metryki jakości predykcji")
Ocena modelu - metryki jakości predykcji
Metryka Wartość
RMSE 3.0194780
Rsquared 0.0708507
MAE 0.9244876

Ocena modelu

RMSE (Root Mean Square Error) obliczono jako miarę różnicy między wartościami rzeczywistymi a przewidywanymi na zbiorze testowym. Wartość ta informuje o średnim błędzie prognoz w jednostkach zmiennej celu. Wykres wizualizuje różnice między wartościami rzeczywistymi a przewidzianymi przez regresor, co ułatwia identyfikację ewentualnych wzorców błędu.

rmse <- sqrt(mean((testing_data$Average.Voltage - predictions)^2))

RMSE na zbiorze testowym: 3.019478

Poniższy wykres przedstawia wartości zbioru testowego oraz wartości przewidziane przez regresor.

prediction_comparison_df <- tibble(X = testing_data$Battery.ID,
                                   actual = testing_data$Average.Voltage,
                                   predicted = predictions)
prediction_comparison_df$Observation <- seq_along(prediction_comparison_df$X)

p <- ggplot(prediction_comparison_df, aes(x = Observation)) +
  geom_line(aes(y = actual, color = "Wartość rzeczywista"), linetype = "solid", alpha = 0.5) +
  geom_line(aes(y = predicted, color = "Wartość przewidziana"), linetype = "dashed", alpha = 0.5) +
  labs(color = "Wartości", x = "Nr obserwacji", y = "Average Voltage [V]") +
  theme_light() +
  scale_x_continuous(
    breaks = seq(1, nrow(prediction_comparison_df), by = 1000),
    labels = scales::comma_format()
  ) +
  scale_y_continuous(
    limits = c(min(prediction_comparison_df$actual, prediction_comparison_df$predicted),
               max(prediction_comparison_df$actual, prediction_comparison_df$predicted))
  ) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

interactive_plot <- ggplotly(p) %>%
  layout(
    hovermode = "x unified",
    xaxis = list(
      title = "Nr obserwacji"
    ),
    yaxis = list(
      title = "Average Voltage [V]"
    ),
    shapes = list(
      list(
        type = "line",
        x0 = 0,
        x1 = 1,
        y0 = 0,
        y1 = 1,
        line = list(color = "gray", dash = "dot")
      )
    )
  )

interactive_plot

Ważność atrybutów

Analiza ważności atrybutów pozwala zidentyfikować te cechy, które mają największy wpływ na przewidywanie zmiennej celu. Wartości ważności są wizualizowane w postaci wykresu słupkowego, co ułatwia interpretację i wybór istotnych predyktorów.

importance <- varImp(model_lm, scale = FALSE)
importance_df <- importance$importance %>%
  rownames_to_column(var = "attribute") %>%
  arrange(desc(Overall))

p <- ggplot(importance_df, aes(x = reorder(attribute, Overall), y = Overall, fill = Overall)) +
  geom_bar(stat = "identity") +
  labs(x = "Atrybut", y = "Ważność") +
  scale_fill_gradient() +
  theme_light() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

ggplotly(p)

Analizując powyższy wykres można stwierdzić, że największy wpływ na przewidywaną wartość średniego napięcia miał parametr energii wulumetrycznej oraz pojemności wolumetrycznej. Mniejszy wpływ miały również trybuty maksymalnej zmiany objętości oraz wskaźnik stabilności materiału.